home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Gigarom 1
/
Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso
/
FILES
/
HYP
/
H-I
/
Inflate 2.0 XCMD.sea
/
Inflate XCMDƒ
/
Inflate.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-09-27
|
5KB
|
137 lines
{XCMD: Inflate}
{Written by: Stephen E. Breish}
{Version: 2.0}
{Date: 9/27/91}
{Copyright ©1991 Stephen E. Breish}
{Params: 1. Position Code (C,TL,TR,BL,BR) 2. Content Code (S,P,R) 3. String or Resource ID}
unit dummyUnit;
interface
uses
Traps, Types, Quickdraw, TextEdit, Menus, GestaltEqu, Balloons, HyperXcmd;
procedure Main (paramPtr: XCmdPtr);
implementation
procedure Inflate (paramPtr: XCmdPtr);
FORWARD;
procedure Main (paramPtr: XCmdPtr);
begin
Inflate(paramPtr);
end;
procedure Inflate (paramPtr: XCmdPtr);
var
HELPMSG: HMMessageRecord;
RCT: Rect;
MOUSE: Point;
VARCODE: integer;
result: OSErr;
response: longint;
procedure return (value: str255);
begin
paramPtr^.returnValue := PasToZero(paramPtr, value); {returns the message via "the result"}
exit(Inflate); {and stops execution of this XCMD}
end;
procedure getTargetRect;
var
rctStr: Str255;
hand: handle;
begin
hand := EvalExpr(paramPtr, 'the rect of the target'); {determine the rectangle of the target field}
ZeroToPas(paramPtr, hand^, rctStr); {or button so we can know where to put the}
disposHandle(hand); {balloon help}
StrToRect(paramPtr, rctStr, RCT); {convert the string to a rect}
end;
procedure getPointAndVar;
var
pointCode: str255;
rctH, rctV: integer;
begin
ZeroToPas(paramPtr, paramPtr^.params[1]^, pointCode);
localToGlobal(RCT.botRight); {translate the local coordinates to global}
localToGlobal(RCT.topLeft); {from a point relative to the window to a point relative to the screen}
if pointCode = 'TR' then {point to the Top Right}
begin
SetPt(MOUSE, RCT.right, RCT.top); {set the point of the balloon}
VARCODE := 6; {use balloon position 6 (see IM vol VI)}
end
else if pointCode = 'TL' then {point to the Top Left}
begin
SetPt(MOUSE, RCT.left, RCT.top);
VARCODE := 5;
end
else if pointCode = 'BR' then {point to the Bottom Right}
begin
SetPt(MOUSE, RCT.right, RCT.bottom);
VARCODE := 0;
end
else if pointCode = 'BL' then {point to the Bottom Left}
begin
SetPt(MOUSE, RCT.left, RCT.bottom);
VARCODE := 3;
end
else if pointCode = 'C' then {point to the Center}
begin
rctH := (RCT.right - RCT.left) div 2; {calculate half the width and height of the rect}
rctV := (RCT.bottom - RCT.top) div 2; {to allow us to center the balloon point}
SetPt(MOUSE, (RCT.right - rctH), (RCT.bottom - rctV)); {make the point "MOUSE" point at the center of the field/button}
VARCODE := 0; {use balloon position 0 (see IM vol VI)}
end
else
return(''); {abort if user didn't specify the proper code}
end;
procedure setHelpMsgRec;
var
typeCode: str255;
tempStr: str255;
begin
ZeroToPas(paramPtr, paramPtr^.params[2]^, TypeCode);
if typeCode = 'S' then
begin
HELPMSG.hmmHelpType := khmmString; {specify the type of the next field in the help record as a string}
ZeroToPas(paramPtr, paramPtr^.params[3]^, HELPMSG.hmmString); {put the string parameter into the help message record}
end
else if typeCode = 'P' then
begin
HELPMSG.hmmHelpType := KhmmPict; {specify the type of the next field in the help record as a PICT}
ZeroToPas(paramPtr, paramPtr^.params[3]^, tempStr);
HELPMSG.hmmPict := StrToNum(paramPtr, tempStr); {put the resource ID for the PICT into the help message record}
end
else if typeCode = 'R' then
begin
HELPMSG.hmmHelpType := KhmmSTRRes; {specify the type of the next field in the help record as a STR}
ZeroToPas(paramPtr, paramPtr^.params[3]^, tempStr);
HELPMSG.hmmSTRRes := StrToNum(paramPtr, tempStr); {put the resource ID for the STR into the help message record}
end
else
return(''); {abort if user didn't specify the proper code}
end;
begin
result := Gestalt(gestaltHelpMgrAttr, response); {check if help manager is present}
if (result <> noErr) or (not BitTst(@response, 31 - gestaltHelpMgrPresent)) then {if not then stop execution of the XCMD}
exit(Inflate);
if (paramPtr^.paramCount <> 3) then {check for proper syntax, if incorrect}
return('Form is: Inflate <Point Code>, <Content Code>, <Content Value or ID>'); {then return the error message}
getTargetRect;
getPointAndVar;
setHelpMsgRec;
result := HMShowBalloon(HELPMSG, MOUSE, @RCT, nil, 0, VARCODE, kHMRegularWindow); {show the balloon!}
end;
end.